6  Interactive table

✓ All shared objects created successfully from _objects.R

A digital presentation of results offers more options to be creative, including interactive content (e.g., for for an organization or private website). We will thus transform the poster-ready ?tbl-advanced-design-annotated into an interactive one. The interactive component will be the plots - we will display species names on hover over the individual data points. We will use the {ggiraph} package to achieve this.

Show code
library(ggiraph)

We will keep the chosen colour scheme and a visualization combining distribution with individual data points. We will however move from a half-violin plot to a standard violin plot and overlay the measurements (geom_gitter()) on top of it. This will give us more room to separate the data points from each other and our reader easier access to the species names.

The ggiraph-book is an excellent resource about the package and I am thus on purpose cutting this part short. In brief, we use the _interactive versions of common {ggplot2} geometries to add interactivity to a plot and display the result using the girafe() function. For fine tuning the resulting visualization, we can use CSS.

Let’s use a subset of the vegetation data (C4 species of Kenya) while working on the code for an interactive scatter plot overlayed on a violin plot.

Show code
data_to_plot <- dat_vegetation |>
  filter(country == "Kenya", type == "C<sub>4</sub>")

p_violin <- ggplot(data_to_plot, aes(x = country, y = delta)) +
  geom_violin(colour = "#005C55FF", fill = "#005C55FF", alpha = 0.25) +
  geom_jitter_interactive(aes(tooltip = species), shape = 21, size = 3, fill = "#005C55FF", colour = "white") +
  scale_y_continuous(breaks = c(-10, -20, -30, -40)) +
  coord_cartesian(ylim = c(-45, -10)) +
  theme_classic() +
  theme(
    plot.margin = margin(0, 0, 0, 0),
    panel.background = element_blank(),
    plot.background = element_blank(),
    axis.line.x = element_blank(),
    axis.line.y = element_line(colour = "black", linewidth = 1),
    axis.ticks.y = element_line(colour = "black", linewidth = 1),
    axis.ticks.x = element_blank(),
    axis.text.x = element_blank(),
    axis.text.y = element_text(colour = "black", size = 16),
    axis.title = element_blank(),
    aspect.ratio = 3,
    legend.position = "none"
  )

girafe(
  ggobj = p_violin,
  height_svg = 2,
  width_svg = 2,
  options = "css = background-color: transparent;"
) |>
  girafe_options(
    opts_tooltip(css = "background-color: white; text-color: black; font-style: italic;")
  )
Figure 6.1

Once happy with the outcome, we again wrap the code in a function so that we can use it later with text_transform() as we have done in Chapter 5 previously. However, we will be displaying an HTML content (an htmlwidget) this time. We can dealt with this by saving the ggraph plot into a temporary HTML file (htmltools::save_html()) which we can then “display” using base R readLines() function.

Show code
library(htmltools)
Show code
PlotGirafeViolins <- function(data_to_plot){
  p_violin <- ggplot(data_to_plot, aes(x = country, y = delta)) +
    geom_violin(colour = "#005C55FF", fill = "#005C55FF", alpha = 0.25) +
    geom_jitter_interactive(aes(tooltip = species), shape = 21, size = 3, fill = "#005C55FF", colour = "white") +
    scale_y_continuous(breaks = c(-10, -20, -30, -40)) +
    coord_cartesian(ylim = c(-45, -10)) +
    theme_classic() +
    theme(
      plot.margin = margin(0, 0, 0, 0),
      panel.background = element_blank(),
      plot.background = element_blank(),
      axis.line.x = element_blank(),
      axis.line.y = element_line(colour = "black", linewidth = 1),
      axis.ticks.y = element_line(colour = "black", linewidth = 1),
      axis.ticks.x = element_blank(),
      axis.text.x = element_blank(),
      axis.text.y = element_text(colour = "black", size = 16),
      axis.title = element_blank(),
      aspect.ratio = 3,
      legend.position = "none"
    )

  g_violin <- girafe(
    ggobj = p_violin,
    width_svg = 1,
    height_svg = 1.5,
    options = "css = background-color: transparent;"
  ) |>
    girafe_options(
      opts_tooltip(css = "background-color: white; text-color: black; font-style: italic;")
    )

  # Save the ggiraph plot to a temporary HTML file
  tmpfile <- tempfile(fileext = ".html")
  save_html(g_violin, tmpfile)

  # Read the content of the HTML file as a single character string
  plot_html_content <- paste(readLines(tmpfile, warn = FALSE), collapse = "\n")

  return(plot_html_content)
}

In the overall table layout, we can apply all what we have learned before (grouping of rows, use of the process_md argument, modifying column labels, etc.), but the text_transform() call will become a little more complicated. First of all, we use summarized data summarized_tbl_input as a basis for the resulting table (input for the (gt() function). At the same time, we need access to the pre-processed, full-length data set (dat_vegetation) which is the input for our custom PlotGirafeViolins() function.

To generate the correct violin and scatter plot for each row of the resulting table, we:

Show code
text_transform(
  locations = cells_body(columns = "violin_plot"),
  fn = function(x) {
    lapply(1:length(x), function(i) {
      target_country <- summarized_tbl_input$country[i]
      target_type <- summarized_tbl_input$type[i]

      data_to_plot <- dat_vegetation |>
      filter(country == target_country, type == target_type)

      # Call the modified plotting function and wrap in html()
      PlotGirafeViolins(data_to_plot) |>
        html()
    })
  }
)

And integrated with the remaining code, we get a table with known design and components but interactive charts:

Show code
summarized_tbl_input |> 
  mutate(violin_plot = "") |>
  gt(
    id = "countries_tbl",
    rowname_col = "type",
    groupname_col = "country",
    row_group_as_column = T,
    process_md = T
  ) |>
  fmt_markdown(columns = "type") |>
  fmt_number(columns = "mean_d", decimals = 2) |>
  tab_header(md("&delta;^13^C is a ratio between ^12^C and ^13^C isotopes; photosynthetically more efficient plant species show less negative values")) |> 
  tab_spanner(columns = contains(c("mean", "violin")), label = md("&delta;^13^C")) |>
  cols_label(
    type = "Type",
    mean_d = "Mean",
    violin_plot = "Measurements"
  ) |>
  cols_align(align = "center", columns = everything()) |> 
  # country maps
  text_transform(
    locations = cells_row_groups(),
    fn = function(x) {
      lapply(x, function(y) {
        html(PlotCountry(y) |> ggplot_image(height = px(150), aspect_ratio = 1))
      })
    }
  ) |> 
  # text_transform for html
  text_transform(
    locations = cells_body(columns = "violin_plot"),
    fn = function(x) {
      lapply(1:length(x), function(i) {
        target_country <- summarized_tbl_input$country[i]
        target_type <- summarized_tbl_input$type[i]

        data_to_plot <- dat_vegetation |>
          filter(country == target_country, type == target_type)

        # Call the modified plotting function and wrap in html()
        PlotGirafeViolins(data_to_plot) |>
          html()
      })
    }
  ) |> 
  tab_style(
    style = list(
      cell_text(align = "center")
    ),
    locations = cells_body(columns = everything())
  ) |>
  tab_options(
    table.width = px(500),
    table.font.names = "open sans",
    heading.align = "center",
    column_labels.border.top.color = "white",
    column_labels.border.bottom.color = "white",
    heading.border.bottom.color = "white",
    table_body.border.top.color = "white",
    table_body.border.bottom.color = "white",
    table_body.hlines.color = "white",
    footnotes.border.bottom.color = "white"
  ) |>
  cols_width(
    type ~ px(100),
    mean_d ~ px(100)
  ) |> 
  opt_css(css ="
    #countries_tbl .gt_table {
      background: linear-gradient(180deg, #3F7F68, #DBD797);
    }
    
    #countries_tbl .gt_col_heading, #countries_tbl .gt_column_spanner_outer, #countries_tbl .gt_row.gt_center, #countries_tbl .gt_row.gt_center.gt_stub_row_group, #countries_tbl .gt_row.gt_left.gt_stub, #countries_tbl .gt_row.gt_left.gt_stub_row_group {
      background: transparent; border-right-style: none; vertical-align: middle;
    }
    
    #countries-tbl .girafe_container, #countries-tbl .girafe_container_std, #countries_tbl .ggiraph-svg, #countries-tbl .ggiraph-svg-bg {
      background: transparent;
    }
    
    #countries-tbl .gt_row_group_first{
      background: transparent;
    }") |>
  tab_footnote(md(folio_footnote))
δ13C is a ratio between 12C and 13C isotopes; photosynthetically more efficient plant species show less negative values
δ13C
Mean Measurements
C3 −27.62
C3 −34.11
C3 −27.36
C4 −12.11
C3 −25.28
Data source: vegetation data from the {folio} package
Show code
# final_html_output <- as_raw_html(gt_giraph,
#   inline_css = TRUE
# )